home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio / Ham Radio CD-ROM (Emerald Software) (1995).ISO / mods / caty-767 / y767util.pas < prev   
Pascal/Delphi Source File  |  1989-10-30  |  11KB  |  319 lines
  1. UNIT Y767UTIL (* Y767 Utility routines  D. J. Wilke N3HGQ 09/26/89 *);
  2.  
  3. INTERFACE
  4.  
  5. USES CRT, DOS, Y767GLO;
  6.  
  7. PROCEDURE ZeroVariables;
  8. PROCEDURE Peep(PeepFreq : INTEGER);
  9. PROCEDURE Warble(HiFreq,LoFreq : INTEGER);
  10. PROCEDURE ErrorAlarm(ErrorStr : String86; Col,Row : INTEGER);
  11. PROCEDURE FreqEntryError;
  12. PROCEDURE InKey(VAR Fk : BOOLEAN; VAR Choice : CHAR);
  13. PROCEDURE Pause;
  14. PROCEDURE ScreenWrite(S : String86; Col,Row : BYTE; Attr : INTEGER);
  15. PROCEDURE WriteHex(Hi : BYTE);
  16. PROCEDURE TestFile;
  17. PROCEDURE CheckFreq(FreqTune : REAL);
  18. FUNCTION MultString(Mult : INTEGER; Ch : CHAR) : STRING;
  19. FUNCTION MakeLSDMSD(FreqInt : STRING; N : INTEGER) : STRING;
  20. FUNCTION FreqParm(LSDFreq : STRING; N : INTEGER) : STRING;
  21. FUNCTION Translate(BCDIn : BYTE) : CHAR;
  22. FUNCTION Bin2BCDHex(BinIn : BYTE) : INTEGER;
  23. FUNCTION Fifo(Lifo : String86) : String86;
  24.  
  25. IMPLEMENTATION
  26.  
  27. USES Y767INST;
  28.  
  29. (*▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓*)
  30. PROCEDURE ZeroVariables;
  31. (* Initialize all global variables *)
  32.  
  33. BEGIN (* ZeroVariables *)
  34.     FILLCHAR(Zero1,OFS(Zero2) - OFS(Zero1) + SIZEOF(Zero2),0);
  35. END; (* ZeroVariables *)
  36.  
  37. (*▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓*)
  38. PROCEDURE Peep(PeepFreq : INTEGER);
  39.  
  40. BEGIN (* Peep *)
  41.     SOUND(PeepFreq);                         (* Make a peep @ Freq *)
  42.     DELAY(30);                               (* For 30 mSec *)
  43.     NOSOUND;
  44. END; (* Peep *)
  45.  
  46. (*▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓*)
  47. PROCEDURE Warble(HiFreq,LoFreq : INTEGER);   (* Error audible alarm *)
  48.  
  49. VAR
  50.     Index : INTEGER;
  51.  
  52. BEGIN (* Warble *)
  53.     FOR Index := 1 TO 5 DO BEGIN             (* Number of repetitions *)
  54.         SOUND(HiFreq);
  55.         DELAY(50);
  56.         SOUND(LoFreq);
  57.         DELAY(50);
  58.     END;
  59.     NOSOUND;
  60. END; (* Warble *)
  61.  
  62. (*▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓*)
  63. PROCEDURE ErrorAlarm(ErrorStr : String86; Col,Row : INTEGER);
  64. (* Display error banner @ Col, Row. If Col=0, display centered on screen *)
  65.  
  66. VAR
  67.     Lc : INTEGER;
  68.  
  69. BEGIN (* ErrorAlarm *)
  70.     TEXTCOLOR(EFG);
  71.     TEXTBACKGROUND(EBG);                     (* Error banner colors *)
  72.     IF Col <> 0 THEN BEGIN                   (* Display at specific loc *)
  73.         ScreenWrite(ErrorStr,Col,Row,207);
  74.         Warble(1000,800);
  75.         Delay(1500);
  76.         TEXTCOLOR(DFG);
  77.         TEXTBACKGROUND(DBG);                 (* Default screen colors *)
  78.         ScreenWrite('                 ' ,Col,Row,0);
  79.     END (* IF Col *)
  80.     ELSE BEGIN
  81.         TEXTCOLOR(DFG);
  82.         TEXTBACKGROUND(DBG);                 (* Default screen colors *)
  83.         CLRSCR;
  84.         Lc := 40 - (LENGTH(ErrorStr) DIV 2) + 1;
  85.         TEXTCOLOR(EFG);
  86.         TEXTBACKGROUND(EBG);                 (* Error banner colors *)
  87.         GOTOXY(Lc,Row); WRITE(ErrorStr);     (* Display centered on screen *)
  88.         TEXTCOLOR(DFG);
  89.         TEXTBACKGROUND(DBG);                 (* Default screen colors *)
  90.     END; (* ELSE *)
  91. END; (* ErrorAlarm *)
  92.  
  93. (*▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓*)
  94. PROCEDURE FreqEntryError;
  95.  
  96. BEGIN (* FreqEntryError *)
  97.     FreqErrorFlag := TRUE;                   (* Raise the flag *)
  98.     ErrorAlarm(FreqErr,58,8);                (* Issue the alarm *)
  99. END; (* FreqEntryError *)
  100.  
  101. (*▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓*)
  102. PROCEDURE InKey(VAR Fk : BOOLEAN; VAR Choice : CHAR);
  103. (* Get keyboard input & detect function keys *)
  104.  
  105. VAR
  106.     Ch : CHAR;
  107.  
  108. BEGIN (* InKey *)
  109.     Ch := READKEY;
  110.     IF (Ch = #27) AND KEYPRESSED THEN BEGIN  (* Extended code *)
  111.         Ch := READKEY;
  112.         Fk := TRUE;                          (* If true, choice has F key *)
  113.     END; (* IF Ch *)
  114.     Choice := Ch;                            (* Else choice has key *)
  115. END; (* InKey *)
  116.  
  117. (*▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓*)
  118. PROCEDURE Pause; (* Pause until any key is struck *)
  119.  
  120. BEGIN (* Pause *)
  121.     TEXTCOLOR(19);
  122.     TEXTBACKGROUND(DBG);                     (* Pause colors *)
  123.     WINDOW(1,24,80,25);
  124.     GOTOXY(1,2);
  125.     CLREOL;
  126.     GOTOXY(5,2);
  127.     WRITE('Any key to continue...');
  128.     SOUND(2000);
  129.     DELAY(100);
  130.     NOSOUND;
  131.     REPEAT UNTIL KeyPressed;                 (* Tight loop `til key hit *)
  132.     GOTOXY(1,2);
  133.     CLREOL;
  134.     TEXTCOLOR(DFG);
  135.     TEXTBACKGROUND(DBG);                     (* Default screen colors *)
  136. END; (* Pause *)
  137.  
  138. (*▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓*)
  139. PROCEDURE ScreenWrite(S : String86; Col,Row : BYTE; Attr : INTEGER);
  140. (* Write string directly to video memory *)
  141.  
  142. VAR
  143.     Index : INTEGER;
  144.  
  145. BEGIN
  146.     Attr := Attr SHL 8;                      (* Adjust attribute byte *)
  147.     FOR Index := 1 TO LENGTH(S) DO
  148.         MEMW[ScreenSeg : (Row-1)*160+(Col+Index-2)*2] := ATTR OR ORD(S[Index]);
  149. END; (* ScreenWrite *)
  150.  
  151. (*▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓*)
  152. PROCEDURE WriteHex(Hi : BYTE);
  153. (* Display decimal byte as hexadecimal value *)
  154.  
  155. CONST
  156.     HexDigits : ARRAY[0..15] OF Char = '0123456789ABCDEF';
  157.  
  158. VAR
  159.     Lo        : BYTE;
  160.     HexStr    : STRING[2];
  161. BEGIN (* WriteHex *)
  162.     Lo     := Hi AND $0F;
  163.     Hi     := Hi SHR 4;
  164.     HexStr := HexDigits[Hi] + HexDigits[Lo];
  165.     WRITE(HexStr);
  166. END; (* WriteHex *)
  167.  
  168. (*▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓*)
  169. PROCEDURE TestFile; (* Use UPDATE.DUM for testing purposes *)
  170.  
  171. VAR
  172.     Ok      : BOOLEAN;
  173.     LIFF    : STRING[86];
  174.  
  175. BEGIN (* TestFile *)
  176.     ASSIGN(UpdateFile,'UPDATE.DUM');
  177.     {$I-} RESET(UpdateFile) {$I+};
  178.     Ok := (IORESULT = 0);
  179.     IF Ok THEN BEGIN
  180.         READLN(UpdateFile,LIFF);
  181.         Update := Fifo(LIFF);            (* Convert LIFO to FIFO *)
  182.     END (* IF Ok *)
  183.     ELSE BEGIN
  184.         ErrorAlarm(TfileErr,0,12);       (* Issue Test file error warning *)
  185.         Warble(1000,800);
  186.         Pause;
  187.     END; (* ELSE *)
  188. END; (* TestFile *)
  189.  
  190. (*▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓*)
  191. PROCEDURE CheckFreq(FreqTune : REAL);
  192. (* Check if frequency is within valid range *)
  193.  
  194. BEGIN (* CheckFreq *)
  195.     FreqErrorFlag := FALSE;                  (* Bring down the flag *)
  196.     IF (FreqTune < 0.1) THEN FreqEntryError;
  197.     IF (FreqTune > 29.99999) AND (FreqTune < 50.0) THEN FreqEntryError;
  198.     IF (FreqTune > 50.0) AND (FreqTune < 53.99999) THEN
  199.         IF Module6 <> TRUE THEN FreqEntryError;
  200.     IF (FreqTune > 54.0) AND (FreqTune < 144.0) THEN FreqEntryError;
  201.     IF (FreqTune > 144.0) AND (FreqTune < 147.9999) THEN
  202.         IF Module2 <> TRUE THEN FreqEntryError;
  203.     IF (FreqTune > 148.0) AND (FreqTune < 439.99999) THEN
  204.         IF Module70A <> TRUE THEN FreqEntryError;
  205.     IF NOT FreqErrorFlag THEN
  206.         IF (FreqTune > 148.0) AND (FreqTune < 449.99999) THEN
  207.             IF Module70B <> TRUE THEN FreqEntryError;
  208.     IF (FreqTune > 450.0) THEN FreqEntryError;
  209. END; (* CheckFreq *)
  210.  
  211. (*▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓*)
  212. FUNCTION MultString(Mult : INTEGER; Ch : CHAR) : STRING;
  213. (* Make a null string of length Nuls *)
  214.  
  215. VAR
  216.     MC : STRING;
  217.  
  218. BEGIN (* MultString *)
  219.     MC := '';
  220.     FOR Index := 1 TO Mult DO
  221.         MC := MC + Ch;
  222.     MultString := MC;
  223. END; (* MultString *)
  224.  
  225. (*▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓*)
  226. FUNCTION MakeLSDMSD(FreqInt : STRING; N : INTEGER) : STRING;
  227. (* Construct N byte LSDFreq string (LSD -> MSD) *)
  228.  
  229. VAR
  230.     LSDFreq : STRING[10];
  231.  
  232. BEGIN (* MakeLSDMSD *)
  233.     LSDFreq := '';
  234.     FOR Index := N DOWNTO 0 DO BEGIN         (* Chars 7&8, 5&6 etc...*)
  235.         IF ODD(Index) THEN BEGIN
  236.             LSDFreq := LSDFreq + COPY(FreqInt,Index,2);
  237.             MakeLSDMSD := LSDFreq;
  238.         END; (* IF ODD *)
  239.     END; (* FOR Index *)
  240. END; (* MakeLSDMSD *)
  241.  
  242. (*▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓*)
  243. FUNCTION FreqParm(LSDFreq : STRING; N : INTEGER) : STRING;
  244. (* Convert LSDFreq to N hex bytes *)
  245.  
  246. VAR
  247.     FreqSet      : STRING[10];
  248.     BCDin,Result : INTEGER;
  249.  
  250. BEGIN (* FreqParm *)
  251.     FreqSet := '';
  252.     FOR Index := 1 TO N DO BEGIN
  253.         IF ODD(Index) THEN BEGIN             (* Chars 1&2, 3&4 etc...*)
  254.             VAL(COPY(LSDFreq,Index,2),BCDin,Result);
  255.             FreqSet := FreqSet + Translate(BCDin);
  256.             FreqParm := FreqSet;
  257.         END; (* IF ODD *)
  258.     END; (* FOR Index *)
  259. END; (* FreqParm *)
  260.  
  261. (*▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓*)
  262. FUNCTION Translate(BCDIn : BYTE) : CHAR;
  263. (* Translate BC Decimal numeric variable to BC Hex character *)
  264. (* Don't use Hex ABCDEF *)
  265.  
  266. VAR
  267.     FreqTrans : CHAR;
  268.  
  269. BEGIN (* Translate *)
  270.     IF (BCDIn >= 0) AND (BCDIn < 10)  THEN Translate := CHR(BCDIn);
  271.     IF (BCDIn >  9) AND (BCDIn < 20)  THEN Translate := CHR(BCDIn + 6);
  272.     IF (BCDIn > 19) AND (BCDIn < 30)  THEN Translate := CHR(BCDIn + 12);
  273.     IF (BCDIn > 29) AND (BCDIn < 40)  THEN Translate := CHR(BCDIn + 18);
  274.     IF (BCDIn > 39) AND (BCDIn < 50)  THEN Translate := CHR(BCDIn + 24);
  275.     IF (BCDIn > 49) AND (BCDIn < 60)  THEN Translate := CHR(BCDIn + 30);
  276.     IF (BCDIn > 59) AND (BCDIn < 70)  THEN Translate := CHR(BCDIn + 36);
  277.     IF (BCDIn > 69) AND (BCDIn < 80)  THEN Translate := CHR(BCDIn + 42);
  278.     IF (BCDIn > 79) AND (BCDIn < 90)  THEN Translate := CHR(BCDIn + 48);
  279.     IF (BCDIn > 89) AND (BCDIn < 100) THEN Translate := CHR(BCDIn + 54);
  280. END; (* Translate *)
  281.  
  282. (*▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓*)
  283. FUNCTION Bin2BCDHex(BinIn : BYTE) : INTEGER;
  284. (* Convert binary input byte to BCD hexadecimal digit *)
  285.  
  286. CONST
  287.     (* Use only first 10 Hex digits for BCD Hex conversion *)
  288.     HexDigits : ARRAY[0..9] OF CHAR = '0123456789';
  289.  
  290. VAR
  291.     Hi,Lo         : BYTE;
  292.     HexStr        : STRING[2];
  293.     BCD,Code      : INTEGER;
  294.  
  295. BEGIN (* Bin2BCDHex *)
  296.     Hi            := BinIn;                  (* Start with 8 bits *)
  297.     Lo            := Hi AND $0F;             (* Mask off LS 4 bits for Lo *)
  298.     Hi            := Hi SHR 4;               (* Process MS 4 bits for Hi *)
  299.     HexStr        := HexDigits[Hi] + HexDigits[Lo];    (* Find Hex byte equiv *)
  300.     VAL(HexStr,BCD,Code);                    (* Convert to integer *)
  301.     Bin2BCDHex    := BCD;                    (* Return BCD Hex digit *)
  302. END; (* Bin2BCDHex *)
  303.  
  304. (*▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓*)
  305. FUNCTION Fifo(Lifo : String86) : String86;
  306. (* Inverts Update$ as received (LIFO) to FIFO *)
  307.  
  308. VAR
  309.     Temp : String86;
  310.  
  311. BEGIN
  312.     Temp := '';
  313.     FOR Index := LENGTH(Lifo) DOWNTO 1 DO    (* Invert the string *)
  314.         Temp := Temp + COPY(Lifo,Index,1);
  315.     Fifo := Temp;                            (* Fifo is now update stream *)
  316. END;
  317.  
  318. END. (* of UNIT Y767UTIL *)
  319.